home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / prelude / PreludeRatio.hs < prev    next >
Encoding:
Text File  |  1994-09-27  |  3.3 KB  |  99 lines  |  [TEXT/YHS2]
  1. -- Standard functions on rational numbers
  2.  
  3. module    PreludeRatio (
  4.     Ratio, Rational(..), (%), numerator, denominator, approxRational ) where
  5.  
  6. {-#Prelude#-}  -- Indicates definitions of compiler prelude symbols
  7.  
  8. infixl 7  %, :%
  9.  
  10. prec = 7
  11.  
  12. data  (Integral a)    => Ratio a = a {-# STRICT #-} :% a {-# STRICT #-}
  13.                               deriving (Eq, Binary)
  14.  
  15. type  Rational        =  Ratio Integer
  16.  
  17. (%)            :: (Integral a) => a -> a -> Ratio a
  18. numerator, denominator    :: (Integral a) => Ratio a -> a
  19. approxRational        :: (RealFrac a) => a -> a -> Rational
  20.  
  21.  
  22. reduce _ 0        =  error "(%){PreludeRatio}: zero denominator"
  23. reduce x y        =  (x `quot` d) :% (y `quot` d)
  24.                where d = gcd x y
  25.  
  26.  
  27. x % y            =  reduce (x * signum y) (abs y)
  28.  
  29. numerator (x:%y)    =  x
  30.  
  31. denominator (x:%y)    =  y
  32.  
  33.  
  34. instance  (Integral a)    => Ord (Ratio a)  where
  35.     (x:%y) <= (x':%y')    =  x * y' <= x' * y
  36.     (x:%y) <  (x':%y')    =  x * y' <  x' * y
  37.  
  38. instance  (Integral a)    => Num (Ratio a)  where
  39.     (x:%y) + (x':%y')    =  reduce (x*y' + x'*y) (y*y')
  40.     (x:%y) * (x':%y')    =  reduce (x * x') (y * y')
  41.     negate (x:%y)    =  (-x) :% y
  42.     abs (x:%y)        =  abs x :% y
  43.     signum (x:%y)    =  signum x :% 1
  44.     fromInteger x    =  fromInteger x :% 1
  45.  
  46. instance  (Integral a)    => Real (Ratio a)  where
  47.     toRational (x:%y)    =  toInteger x :% toInteger y
  48.  
  49. instance  (Integral a)    => Fractional (Ratio a)  where
  50.     (x:%y) / (x':%y')    =  (x*y') % (y*x')
  51.     recip (x:%y)    =  if x < 0 then (-y) :% (-x) else y :% x
  52.     fromRational (x:%y) =  fromInteger x :% fromInteger y
  53.  
  54. instance  (Integral a)    => RealFrac (Ratio a)  where
  55.     properFraction (x:%y) = (fromIntegral q, r:%y)
  56.                 where (q,r) = quotRem x y
  57.  
  58. instance  (Integral a)    => Enum (Ratio a)  where
  59.     enumFrom        =  iterate ((+)1)
  60.     enumFromThen n m    =  iterate ((+)(m-n)) n
  61.  
  62. instance  (Integral a) => Text (Ratio a)  where
  63.     readsPrec p  =  readParen (p > prec)
  64.                   (\r -> [(x%y,u) | (x,s)   <- reads r,
  65.                             ("%",t) <- lex s,
  66.                         (y,u)   <- reads t ])
  67.  
  68.     showsPrec p (x:%y)    =  showParen (p > prec)
  69.                                (shows x . showString " % " . shows y)
  70.  
  71.  
  72. -- approxRational, applied to two real fractional numbers x and epsilon,
  73. -- returns the simplest rational number within epsilon of x.  A rational
  74. -- number n%d in reduced form is said to be simpler than another n'%d' if
  75. -- abs n <= abs n' && d <= d'.  Any real interval contains a unique
  76. -- simplest rational; here, for simplicity, we assume a closed rational
  77. -- interval.  If such an interval includes at least one whole number, then
  78. -- the simplest rational is the absolutely least whole number.  Otherwise,
  79. -- the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d
  80. -- and abs r' < d', and the simplest rational is q%1 + the reciprocal of
  81. -- the simplest rational between d'%r' and d%r.
  82.  
  83. approxRational x eps    =  simplest (x-eps) (x+eps)
  84.     where simplest x y | y < x    =  simplest y x
  85.                | x == y    =  xr
  86.                | x > 0    =  simplest' n d n' d'
  87.                | y < 0    =  - simplest' (-n') d' (-n) d
  88.                | otherwise    =  0 :% 1
  89.                     where xr@(n:%d) = toRational x
  90.                           (n':%d')    = toRational y
  91.  
  92.           simplest' n d n' d'    -- assumes 0 < n%d < n'%d'
  93.             | r == 0     =    q :% 1
  94.             | q /= q'    =    (q+1) :% 1
  95.             | otherwise  =    (q*n''+d'') :% n''
  96.                      where (q,r)      =     quotRem n d
  97.                        (q',r')    =     quotRem n' d'
  98.                        (n'':%d'') =     simplest' d' r' d r
  99.